home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / ClockElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-11  |  7.5 KB  |  207 lines  |  [.Ob./.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. MODULE ClockElems; (* gri 18.3.91 / 28.9.93 *)
  4.     IMPORT Texts, TextFrames, TextPrinter, Math, Oberon, Display, Printer, Viewers, Files;
  5.     CONST
  6.         ticks = 300; (* Oberon.Time ticks per second *)
  7.         Rmin = 12; (* minimal clock radius in pixels *)
  8.         Rdef = 8.2; (* default clock radius in mm *)
  9.     TYPE
  10.         Time = RECORD sec, min, hour, hourm: INTEGER; timeStamp, dateStamp: LONGINT END;
  11.         Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
  12.         NotifyMsg = RECORD(Display.FrameMsg) new: Time END;
  13.         sin, cos: ARRAY 60 OF REAL;
  14.         wakeUp: LONGINT; (* overflow in 82.8 days *)
  15.         old: Time; (* displayed time *)
  16.         Task: Oberon.Task;
  17.         Line: PROCEDURE(x1, y1, x2, y2, color, mode: INTEGER); (* current output procedure *)
  18.         Circle: PROCEDURE(x0, y0, r, color, mode: INTEGER); (* current output procedure *)
  19. (* initialization *)
  20.     PROCEDURE Init;
  21.         VAR i: INTEGER;
  22.     BEGIN i := 0;
  23.         WHILE i < 60 DO
  24.             sin[i] := Math.sin(2 * Math.pi / 60 * i);
  25.             cos[i] := Math.cos(2 * Math.pi / 60 * i);
  26.             INC(i)
  27.         END
  28.     END Init;
  29.     PROCEDURE GetTime(VAR time: Time);
  30.         VAR t: LONGINT;
  31.     BEGIN
  32.         Oberon.GetClock(time.timeStamp, time.dateStamp);
  33.         t := time.timeStamp;
  34.         time.sec := SHORT(t MOD 64);
  35.         time.min := SHORT(t DIV 64 MOD 64);
  36.         time.hour := SHORT(t DIV (64*64) MOD 32);
  37.         time.hourm := (time.hour MOD 12)*5 + time.min DIV 12;
  38.         time.timeStamp := t
  39.     END GetTime;
  40.     PROCEDURE SetTime(VAR time: Time);
  41.         VAR t: LONGINT;
  42.     BEGIN
  43.         t := (LONG(time.hour)*64 + time.min)*64 + time.sec;
  44.         Oberon.SetClock(t, time.dateStamp)
  45.     END SetTime;
  46. (* graphics *)
  47.     PROCEDURE SCircle(x0, y0, r, color, mode: INTEGER);
  48.         VAR x, y, dx, dy, d: INTEGER;
  49.         PROCEDURE Dot4(x1, x2, y1, y2, color, mode: INTEGER);
  50.         BEGIN
  51.             Display.Dot(color, x1, y1, mode);
  52.             Display.Dot(color, x1, y2, mode);
  53.             Display.Dot(color, x2, y1, mode);
  54.             Display.Dot(color, x2, y2, mode)
  55.         END Dot4;
  56.     BEGIN
  57.         x := r; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1-4*r;
  58.         WHILE x > y DO
  59.             Dot4(x0-x, x0+x, y0-y, y0+y, color, mode);
  60.             Dot4(x0-y, x0+y, y0-x, y0+x, color, mode);
  61.             INC(d, dy); INC(dy, 8); INC(y);
  62.             IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  63.         END;
  64.         IF x = y THEN Dot4(x0-x, x0+x, y0-y, y0+y, color, mode) END
  65.     END SCircle;
  66.     PROCEDURE SLine(x1, y1, x2, y2, color, mode: INTEGER);
  67.         VAR x, y, dx, dy, d, inc: INTEGER;
  68.     BEGIN
  69.         IF (y2-y1) < (x1-x2) THEN x := x1; x1 := x2; x2 := x; y := y1; y1 := y2; y2 := y END;
  70.         dx := 2*(x2-x1);
  71.         dy := 2*(y2-y1);
  72.         x := x1; y := y1; inc := 1;
  73.         IF dy > dx THEN
  74.             d := dy DIV 2;
  75.             IF dx < 0 THEN inc := -1; dx := -dx END;
  76.             WHILE y <= y2 DO
  77.                 Display.Dot(color, x, y, mode);
  78.                 INC(y); DEC(d, dx);
  79.                 IF d < 0 THEN INC(d, dy); INC(x, inc) END
  80.             END
  81.         ELSE
  82.             d := dx DIV 2;
  83.             IF dy < 0 THEN inc := -1; dy := -dy END;
  84.             WHILE x <= x2 DO
  85.                 Display.Dot(color, x, y, mode);
  86.                 INC(x); DEC(d, dy);
  87.                 IF d < 0 THEN INC(d, dx); INC(y, inc) END
  88.             END
  89.         END 
  90.     END SLine;
  91.     PROCEDURE PCircle(x0, y0, r, color, mode: INTEGER);
  92.     BEGIN Printer.Circle(x0, y0, r)
  93.     END PCircle;
  94.     PROCEDURE PLine(x1, y1, x2, y2, color, mode: INTEGER);
  95.     BEGIN Printer.Line(x1, y1, x2, y2)
  96.     END PLine;
  97. (* view update *)
  98.     PROCEDURE Line2(ang: INTEGER; x0, y0, r1, r2, color: INTEGER);
  99.         VAR x1, y1, x2, y2: INTEGER;
  100.     BEGIN
  101.         ang := (15-ang) MOD 60;
  102.         x1 := SHORT(ENTIER(r1*cos[ang] + 0.5));
  103.         y1 := SHORT(ENTIER(r1*sin[ang] + 0.5));
  104.         x2 := SHORT(ENTIER(r2*cos[ang] + 0.5));
  105.         y2 := SHORT(ENTIER(r2*sin[ang] + 0.5));
  106.         Line(x0+x1, y0+y1, x0+x2, y0+y2, color, Display.invert) 
  107.     END Line2;
  108.     PROCEDURE Draw(VAR time: Time; x0, y0, r, color: INTEGER);
  109.         VAR rh, rm, rs, i: INTEGER;
  110.     BEGIN
  111.         IF r >= Rmin THEN
  112.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11; i := 0;
  113.             WHILE i < 60 DO Line2(i, x0, y0, rm, r, color); INC(i, 5) END;
  114.             Line2(time.sec, x0, y0, rm-r, rs, color);
  115.             Line2(time.min, x0, y0, 0, rm, color);
  116.             Line2(time.hourm, x0, y0, 0, rh, color);
  117.             Circle(x0, y0, 2, color, Display.replace)
  118.         END;
  119.         Circle(x0, y0, r, color, Display.replace)
  120.     END Draw;
  121.     PROCEDURE Update(VAR old, new: Time; x0, y0, r, color: INTEGER);
  122.         VAR rh, rm, rs: INTEGER;
  123.     BEGIN
  124.         IF r >= Rmin THEN
  125.             rh := 7*r DIV 11; rm := 9*r DIV 11; rs := 10*r DIV 11;
  126.             IF old.sec # new.sec THEN Line2(old.sec, x0, y0, rm-r, rs, color); Line2(new.sec, x0, y0, rm-r, rs, color) END;
  127.             IF old.min # new.min THEN Line2(old.min, x0, y0, 0, rm, color); Line2(new.min, x0, y0, 0, rm, color) END;
  128.             IF old.hourm # new.hourm THEN Line2(old.hourm, x0, y0, 0, rh, color); Line2(new.hourm, x0, y0, 0, rh, color) END;
  129.         END
  130.     END Update;
  131. (* methods *)
  132.     PROCEDURE HandleFrame(F: Display.Frame; VAR msg: Display.FrameMsg);
  133.         VAR r: INTEGER; V: Viewers.Viewer; ch: CHAR; new: Time;
  134.     BEGIN
  135.         IF msg IS NotifyMsg THEN Line := SLine; Circle := SCircle; r := F.W DIV 2;
  136.             Update(old, msg(NotifyMsg).new, F.X+r, F.Y+r, r, F(Frame).col)
  137.         ELSIF msg IS Oberon.InputMsg THEN
  138.             WITH msg: Oberon.InputMsg DO
  139.                 IF msg.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y) END
  140.             END
  141.         END
  142.     END HandleFrame;
  143.     PROCEDURE HandleElem(E: Texts.Elem; VAR msg: Texts.ElemMsg);
  144.         VAR CopyOfE: Texts.Elem; F: Frame; r: INTEGER; ch: CHAR;
  145.     BEGIN
  146.         IF msg IS TextFrames.DisplayMsg THEN
  147.             WITH msg: TextFrames.DisplayMsg DO
  148.                 IF ~msg.prepare THEN
  149.                     Line := SLine; Circle := SCircle; r := SHORT((E.W DIV TextFrames.Unit - 1) DIV 2);
  150.                     Draw(old, msg.X0+r, msg.Y0+r, r, msg.col);
  151.                     NEW(F); F.X := msg.X0; F.Y := msg.Y0; F.W := 2*r + 1; F.H := F.W;
  152.                     F.handle := HandleFrame; F.col := msg.col;
  153.                     msg.elemFrame := F
  154.                 END
  155.             END
  156.         ELSIF msg IS TextPrinter.PrintMsg THEN
  157.             WITH msg: TextPrinter.PrintMsg DO
  158.                 IF ~msg.prepare THEN
  159.                     Line := PLine; Circle := PCircle; r := SHORT((E.W DIV TextPrinter.Unit - 1) DIV 2);
  160.                     Draw(old, msg.X0+r, msg.Y0+r, r, msg.col)
  161.                 END
  162.             END
  163.         ELSIF msg IS Texts.CopyMsg THEN
  164.             NEW(CopyOfE); Texts.CopyElem(E, CopyOfE); msg(Texts.CopyMsg).e := CopyOfE
  165.         ELSIF msg IS Texts.IdentifyMsg THEN
  166.             WITH msg: Texts.IdentifyMsg DO
  167.                 msg.mod := "ClockElems"; msg.proc := "New"
  168.             END
  169.         ELSIF msg IS Texts.FileMsg THEN
  170.             WITH msg: Texts.FileMsg DO
  171.                 IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
  172.                 ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
  173.                 END
  174.             END
  175.         END
  176.     END HandleElem;
  177.     PROCEDURE* Clock;
  178.         VAR msg: NotifyMsg;
  179.     BEGIN
  180.         IF Oberon.Time() >= wakeUp THEN GetTime(msg.new);
  181.             IF msg.new.timeStamp # old.timeStamp THEN wakeUp := Oberon.Time() + ticks * 15 DIV 16;
  182.                 Viewers.Broadcast(msg); old := msg.new
  183.             ELSE wakeUp := Oberon.Time() + ticks DIV 16 (* synchronization *)
  184.             END
  185.         END
  186.     END Clock;
  187. (* commands *)
  188.     PROCEDURE New*;
  189.     BEGIN NEW(Texts.new); Texts.new.handle := HandleElem
  190.     END New;
  191.     PROCEDURE Insert*;
  192.         VAR S: Texts.Scanner; r: REAL; w: LONGINT; E: Texts.Elem; m: TextFrames.InsertElemMsg;
  193.     BEGIN
  194.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  195.         IF (S.line = 0) & (S.class = Texts.Int) & (S.i > 0) THEN r := S.i
  196.         ELSIF (S.line = 0) & (S.class = Texts.Real) & (S.x > 0) THEN r := S.x
  197.         ELSE r := Rdef
  198.         END;
  199.         w := ENTIER(2*TextFrames.mm*r);
  200.         NEW(E); E.W := w; E.H := w; E.handle := HandleElem; m.e := E;
  201.         Oberon.FocusViewer.handle(Oberon.FocusViewer, m)
  202.     END Insert;
  203. BEGIN
  204.     Init; wakeUp := 0; GetTime(old);
  205.     NEW(Task); Task.safe := FALSE; Task.handle := Clock; Oberon.Install(Task)
  206. END ClockElems.
  207.